Games of Daze/Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso/x2ftp/msdos/source/demostuf/tweak1.pas

Pascal/Delphi Source File | 1994-07-25 | 4.2 KB | 219 lines

UNIT TWEAK1;
{
    Converts IFF/ILBM image file with format 320*200 in 256 colours with
    packed colours to a raw image - but bonus-tweak-vga raw image...

  THIS PROGRAM WAS CODED BY BJARKE VIKS0E.
  YOU ARE FREE TO DO WHATEVER YOU WANT WITH THIS PIECE OF CODE.
  E-MAIL ME AT: [e-mail] IN 1994 FOR CHAT AND CODE.
}

INTERFACE

uses
    DEMOINIT;

type
    pIFFBuffer = ^IFFbuffertype;
    IFFbuffertype = array[1..65528] of byte;
    filestring = string[30];

var
    cmap : array[1..256*3] of byte;

procedure LoadPix(p : pScreen; filename : filestring);
procedure ConvertIFF(p : pScreen; v : pIFFBuffer);
procedure SetCMAP;
procedure Copy2Screen(v : pScreen; s : pScreen);
procedure FadeCMAP(faktor : integer);


IMPLEMENTATION

var
    n,d : word;


procedure IFFcmap(v : pIFFBuffer; i, clength : longint);
var
    r,g,b : byte;
    j,k : integer;
begin
    k:=1;
    for j:=0 to (clength DIV 3)-1 do begin
        r:=v^[i] div 4; g:=v^[i+1] div 4; b:=v^[i+2] div 4;
        inc(i,3);
        cmap[k]:=r; cmap[k+1]:=g; cmap[k+2]:=b;
        inc(k,3);
    end;
    cmap[1]:=0; cmap[2]:=0; cmap[3]:=0;
end;

procedure IFFfindPos; assembler;
asm
    mov    ax,d
    cmp    ax,0
    jne    @not1
    mov    ax,(320*200/4)
    jmp    NEAR PTR @ok
@not1:
    cmp    ax,(320*200/4)
    jne    @not2
    mov    ax,(320*200/4)*2
    jmp    NEAR PTR @ok
@not2:
    cmp    ax,(320*200/4)*2
    jne    @not3
    mov    ax,(320*200/4)*3
    jmp    NEAR PTR @ok
@not3:
    cmp    ax,(320*200/4)*3
    jne    @ok
    xor    ax,ax
    inc    n
@ok:
    mov    d,ax
end;


procedure IFFbody(p : pScreen; v : pIFFBuffer; i : longint; VAR done : boolean);
var
    x : word;
    c : shortint;
    fill : byte;
begin
    x:=0;
    n:=0;            { actual offset }
    d:=0;            { pointer to which of the 4 buffers we are printing in... }

    repeat
        c:=v^[i]; inc(i);
        if (c < 0) then begin
            c:=-c;
            fill:=v^[i]; inc(i);
            for x:=x to x+c do begin
                p^[n+d]:=fill;
                IFFfindPos;
            end;
        end
        else begin
            for x:=x to x+c do begin
                p^[n+d]:=v^[i];
                inc(i);
                IFFfindPos;
            end;
        end;
    until (n >= WIDTH*200);

    done:=TRUE;
end;


procedure ConvertIFF(p : pScreen; v : pIFFBuffer);
var
    i : longint;
    done : boolean;
    flength : longint;
    clength : longint;
    chunkname : string[4];
begin
    if (char(v^[1])<>'F') AND (char(v^[2])<>'O') AND (char(v^[3])<>'R') AND (char(v^[4])<>'M') then halt;
    flength:=v^[5] shl 8;
    inc(flength,v^[6]); flength:=flength shl 8;
    inc(flength,v^[7]); flength:=flength shl 8;
    inc(flength,v^[8]);
    if (char(v^[9])<>'P') AND (char(v^[10])<>'B') AND (char(v^[11])<>'M') AND (char(v^[12])<>' ') then halt;

    i:=13;
    done:=FALSE;

    repeat
        chunkname:=concat(char(v^[i]),char(v^[i+1]),char(v^[i+2]),char(v^[i+3]));
        inc(i,4);

        clength:=v^[i] shl 8;
        inc(clength,v^[i+1]); clength:=clength shl 8;
        inc(clength,v^[i+2]); clength:=clength shl 8;
        inc(clength,v^[i+3]);
        if ((clength and 1) <> 0) then inc(clength);
        inc(i,4);

        if (chunkname='CMAP') then IFFcmap(v, i,clength);
        if (chunkname='BODY') then IFFbody(p,v, i,done);
        inc(i,clength);
    until (i > flength) OR done;
end;


procedure LoadPix(p : pScreen; filename : filestring);
var
    pFileMem: pIFFBuffer;
    FileHandle : file;
    size : longint;
begin
    Assign(FileHandle, filename);
    Reset(FileHandle, 1);
    size := filesize(FileHandle);
    GetMem(pFileMem, size);
    BlockRead(FileHandle, pFileMem^, size);
    Close(FileHandle);
    ConvertIFF(p, pFileMem);
    FreeMem(pFileMem, size);
end;


(*--------------------------------------*)

procedure SetCMAP;
var
    i,j : integer;
begin
    j:=1;
    for i:=0 to 255 do begin
        SetRGB(i,cmap[j],cmap[j+1],cmap[j+2]);
        inc(j,3);
    end;
end;

procedure CopyPlane(v : pScreen; s : pScreen); assembler;
asm
    push    ds
    lds    si,v
    les    di,s
    cld
    mov    cx,80*200/2
    rep movsw
    pop    ds
end;

procedure Copy2Screen(v : pScreen; s : pScreen);
const
    size = 80*200;
begin
    SetBitplanes(1);
    CopyPlane(@v^[0],s);
    SetBitplanes(2);
    CopyPlane(@v^[size],s);
    SetBitplanes(4);
    CopyPlane(@v^[size*2],s);
    SetBitplanes(8);
    CopyPlane(@v^[size*3],s);
end;


procedure FadeCMAP(faktor : integer);
var
    i,j : integer;
begin
    VBLANK;
    j:=1;
    for i:=0 to 255 do begin
        SetRGB(i,
                longmul(cmap[j],faktor) shr 8,
                longmul(cmap[j+1],faktor) shr 8,
                longmul(cmap[j+2],faktor) shr 8);
        inc(j,3);
    end;
end;

end.